home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2009 February / PCWFEB09.iso / Software / Linux / Kubuntu 8.10 / kubuntu-8.10-desktop-i386.iso / casper / filesystem.squashfs / usr / bin / debconf-set-selections < prev    next >
Text File  |  2008-10-10  |  3KB  |  149 lines
  1. #!/usr/bin/perl
  2. # This file was preprocessed, do not edit!
  3.  
  4.  
  5. sub usage {
  6.     print STDERR <<EOF;
  7. Usage: debconf-set-selections [-vcu] [file]
  8.   -v, --verbose     verbose output
  9.   -c, --checkonly   only check the input file format
  10.   -u, --unseen      do not set the 'seen' flag when preseeding values
  11. EOF
  12.     exit(1);
  13. }
  14.  
  15.  
  16. use warnings;
  17. use strict;
  18. use Debconf::Db;
  19. use Debconf::Template;
  20. use Getopt::Long;
  21.  
  22. use vars qw(%opts $filename $debug $error $checkonly $unseen);
  23.  
  24. sub info {
  25.     my $msg = shift;
  26.     print STDERR "info: $msg\n" if $debug;
  27. }
  28.  
  29. sub warning {
  30.     my $msg = shift;
  31.     print STDERR "warning: $msg\n";
  32. }
  33.  
  34. sub error {
  35.     my $msg = shift;
  36.     print STDERR "error: $msg\n";
  37.     $error++
  38. }
  39.  
  40. sub load_answer {
  41.     my ($owner, $label, $type, $content) = @_;
  42.     
  43.     info "Loading answer for '$label'";
  44.  
  45.     my $template=Debconf::Template->get($label);
  46.     if (! $template) {
  47.         $template=Debconf::Template->new($label, $owner, $type);
  48.         $template->description("Dummy template");
  49.         $template->extended_description("This is a fake template used to pre-seed the debconf database. If you are seeing this, something is probably wrong.");
  50.     }
  51.     else {
  52.         $template->default($content);
  53.     }
  54.     $template->type($type);
  55.     
  56.     my $question=Debconf::Question->get($label);
  57.     if (! $question) {
  58.         error("Cannot find a question for $label");
  59.         return;
  60.     }
  61.     $question->addowner($owner, $type);
  62.     $question->value($content);
  63.     if (! $unseen) {
  64.         $question->flag("seen", "true");
  65.     }
  66. }
  67.  
  68. sub set_flag {
  69.     my ($owner, $label, $flag, $content) = @_;
  70.  
  71.     info "Setting $flag flag";
  72.  
  73.     my $question=Debconf::Question->get($label);
  74.     if (! $question) {
  75.         error("Cannot find a question for $label");
  76.         return;
  77.     }
  78.     $question->flag($flag, $content);
  79. }
  80.  
  81. my @knowntypes = qw(select boolean string multiselect note password text title);
  82. my @knownflags = qw(seen);
  83.  
  84. sub ok_format {
  85.     my ($owner, $label, $type, $content) = @_;
  86.     if (! defined $owner || ! defined $label || ! defined $content) {
  87.         error "parse error on line $.: '$_'";
  88.         return;
  89.     }
  90.     elsif (! grep { $_ eq $type } @knowntypes, @knownflags) {
  91.         warning "Unknown type $type, skipping line $.";
  92.         return;
  93.     }
  94.     else {
  95.         return 1;
  96.     }
  97. }
  98.  
  99. sub mungeline ($) {
  100.     my $line=shift;
  101.     chomp $line;
  102.     $line=~s/\#.*$//;
  103.     $line=~s/\r$//;
  104.     return $line;
  105. }
  106.  
  107.  
  108. GetOptions(
  109.     "verbose|v" => \$debug,
  110.     "checkonly|c" => \$checkonly,
  111.     "unseen|u" => \$unseen,
  112. ) || usage();
  113.  
  114. Debconf::Db->load;
  115.  
  116. $error = 0;
  117.  
  118. while (<>) {
  119.     $_=mungeline($_);
  120.     while (/\\$/ && ! eof) {
  121.         s/\\$//;
  122.         $_.=mungeline(<>);
  123.     }
  124.     next if /^\s*$/;
  125.     my ($owner, $label, $type, $content) = /^\s*(\S+)\s+(\S+)\s+(\S+)(?:\s(.*))?/;
  126.     if (! defined $content) {
  127.         $content='';
  128.     }
  129.     if (ok_format($owner, $label, $type, $content)) {
  130.         if (grep { $_ eq $type } @knownflags) {
  131.             info "Trying to set '$type' flag to '$content'";
  132.             set_flag($owner, $label, $type, $content);
  133.         }
  134.         else {
  135.             info "Trying to set '$label' [$type] to '$content'";
  136.             load_answer($owner, $label, $type, $content);
  137.         }
  138.     }
  139. }
  140.  
  141. if (! $checkonly) {
  142.     Debconf::Db->save;
  143. }
  144.  
  145. if ($error) {
  146.     exit 1;
  147. }
  148.  
  149.